home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / infoplus.zip / INFOPLUS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-06-25  |  13KB  |  654 lines
  1. (*
  2. **  INFOPLUS.PAS
  3. **
  4. **  Version 1.00 by Andrew Rossmann 6/25/90
  5. *)
  6.  
  7. (*$A-,B-,D-,F-,I-,N-,O-,R-,S-,V-*)
  8. (*$M 65520, 0, 0*)
  9. program INFOPLUS;
  10.  
  11. uses
  12.   crt, dos, graph;
  13.  
  14. const
  15.   qversion = 'Version 1.00';
  16.   qdate = 'June 25, 1990';
  17.   BIOSdseg = $0040;
  18.   pgmax = 17;
  19.   pchar = [' '..'~'];
  20.   secsiz = 512;
  21.   tick1 = 1193180;
  22.  
  23. type
  24.   cpu_info_t = record
  25.     cpu_type : byte;
  26.     MSW : word;
  27.     GDT : array[1..6] of byte;
  28.     IDT : array[1..6] of byte;
  29.     intflag : boolean;
  30.     ndp_type : byte;
  31.     ndp_cw : word
  32.   end;
  33.   char2 = string[2];
  34.  
  35. var
  36.   attrsave : byte;
  37.   country : array[0..33] of byte;
  38.   currdrv : byte;
  39.   devofs : word;
  40.   devseg : word;
  41.   dirsep : set of char;
  42.   DOScofs : word;
  43.   DOScseg : word;
  44.   DOSmem : longint;
  45.   equip : word;
  46.   graphdriver : integer;
  47.   i : word;
  48.   intvec : array[$00..$FF] of pointer;
  49.   lastdrv : byte;
  50.   osmajor : byte;
  51.   osminor : byte;
  52.   pg : 0..pgmax;
  53.   regs : registers;
  54.   switchar : char;
  55.   tlength : byte;
  56.   twidth : byte;
  57.   vidpg : byte;
  58.   x1 : byte;
  59.   x2 : byte;
  60.   xbool1 : boolean;
  61.   xbool2 : boolean;
  62.   xchar1 : char;
  63.   xchar2 : char;
  64.   xword : word;
  65.   gotcountry: boolean;
  66.   c2: char2;
  67.   endit: boolean;
  68.   ccode: word;
  69.  
  70. (*$L INFOPLUS*)
  71.  
  72. function getkey2: char2;
  73.   var
  74.     c: char;
  75.     c2: char2;
  76.  
  77.   begin
  78.   c:=ReadKey;
  79.   if c = #0 then
  80.     getkey2:=c + ReadKey
  81.   else
  82.     getkey2:=c;
  83.   end; {getkey2}
  84.  
  85. {^Make sure number entered, not any letters}
  86. function getnum: word;
  87.   var
  88.     inpchar: char;
  89.     number_string: string[2];
  90.     temp, position, code: word;
  91.     row, col: byte;
  92.     finish: boolean;
  93.  
  94.   begin
  95.   row:=WhereY;
  96.   col:=WhereX;
  97.   Write(' ':3);
  98.   GotoXY(col, row);
  99.   temp:=99;
  100.   finish:=false;
  101.   position:=0;
  102.   number_string:='';
  103.   TextColor(LightGray);
  104.   repeat
  105.     inpchar:=ReadKey;
  106.     case inpchar of
  107.       '0'..'9':if position < 2 then
  108.         begin
  109.         Inc(position);
  110.         Inc(number_string[0]);
  111.         number_string[position]:=inpchar;
  112.         Write(inpchar)
  113.         end;
  114.       #8: if position > 0 then
  115.         begin
  116.         Dec(position);
  117.         Dec(number_string[0]);
  118.         Write(^H' '^H)
  119.         end;
  120.       #27: if number_string = '' then
  121.           finish:=true
  122.         else
  123.           begin
  124.           number_string:='';
  125.           GotoXY(col, row);
  126.           ClrEol;
  127.           position:=0
  128.           end;
  129.       #13: finish:=true
  130.     end {case}
  131.   until finish;
  132.   if number_string <> '' then
  133.     Val(number_string, temp, code);
  134.   getnum:=temp
  135.   end; {getnum}
  136.  
  137. procedure caption1(a: string);
  138.   begin
  139.   textcolor(LightGray);
  140.   write(a);
  141.   textcolor(LightCyan)
  142.   end; {caption1}
  143.  
  144. procedure caption2(a: string);
  145.   const
  146.     capterm = ': ';
  147.  
  148.   var
  149.     i: byte;
  150.     xbool: boolean;
  151.  
  152.   begin
  153.   i:=length(a);
  154.   while (i > 0) and (a[i] = ' ') do
  155.     dec(i);
  156.   insert(capterm, a, i + 1);
  157.   caption1(a)
  158.   end; {caption2}
  159.  
  160. function nocarry : boolean;
  161.   begin
  162.   nocarry:=regs.flags and fcarry = $0000
  163.   end; {nocarry}
  164.  
  165. function hex(a : word; b : byte) : string;
  166.   const
  167.     digit : array[$0..$F] of char = '0123456789ABCDEF';
  168.  
  169.   var
  170.     i : byte;
  171.     xstring : string;
  172.  
  173.   begin
  174.   xstring:='';
  175.   for i:=1 to b do
  176.     begin
  177.     insert(digit[a and $000F], xstring, 1);
  178.     a:=a shr 4
  179.     end;
  180.   hex:=xstring
  181.   end; {hex}
  182.  
  183. procedure unknown(a : string; b : word; c : byte);
  184.   begin
  185.   writeln('(unknown', ' ', a, ' ', hex(b, c), ')')
  186.   end; {unknown}
  187.  
  188. procedure caption3(a : string);
  189.   begin
  190.   caption2('  ' + a)
  191.   end; {caption3}
  192.  
  193. procedure yesorno(a : boolean);
  194.   begin
  195.   if a then
  196.     writeln('yes')
  197.   else
  198.     writeln('no')
  199.   end; {yesorno}
  200.  
  201. procedure dontknow;
  202.   begin
  203.   writeln('(unknown)')
  204.   end; {dontknow}
  205.  
  206. procedure segofs(a, b : word);
  207.   begin
  208.   write(hex(a, 4), ':', hex(b, 4))
  209.   end; {segofs}
  210.  
  211. function showchar(a : char) : char;
  212.   begin
  213.   if a in pchar then
  214.     showchar:=a
  215.   else
  216.     showchar:='.'
  217.   end; {showchar}
  218.  
  219. procedure pause1;
  220.   var
  221.     xbyte : byte;
  222.     xchar : char2;
  223.     savex, savey: byte;
  224.  
  225.   begin
  226.   xbyte:=textattr;
  227.   endit:=false;
  228.   textcolor(Cyan);
  229.   savex:=WhereX;
  230.   savey:=WhereY;
  231.   Write('( for more)');
  232.   xchar:=getkey2;
  233.   if xchar <> #0#80 then
  234.     begin
  235.     endit:=true;
  236.     c2:=xchar
  237.     end;
  238.   textattr:=xbyte;
  239.   GotoXY(savex, savey);
  240.   Write('            ')
  241.   end; {pause1}
  242.  
  243. procedure pause2;
  244.   var
  245.     xbyte : byte;
  246.  
  247.   begin
  248.   if wherey + hi(windmin) > hi(windmax) then
  249.     begin
  250.     xbyte:=TextAttr;
  251.     TextColor(Cyan);
  252.     pause1;
  253.     clrscr;
  254.     writeln('(continued)');
  255.     textattr:=xbyte
  256.     end
  257.   end; {pause2}
  258.  
  259. function bin4(a : byte) : string;
  260.   const
  261.     digit : array[0..1] of char = '01';
  262.  
  263.   var
  264.     xstring : string;
  265.     i : byte;
  266.  
  267.   begin
  268.   xstring:='';
  269.   for i:=3 downto 0 do
  270.     begin
  271.     insert(digit[a mod 2], xstring, 1);
  272.     a:=a shr 1
  273.     end;
  274.   bin4:=xstring
  275.   end; {bin4}
  276.  
  277. procedure offoron(a : string; b : boolean);
  278.   begin
  279.   caption3(a);
  280.   if b then
  281.     writeln('on')
  282.   else
  283.     writeln('off')
  284.   end; {offoron}
  285.  
  286. procedure zeropad(a : word);
  287.   begin
  288.   if a < 10 then
  289.     write('0');
  290.   write(a)
  291.   end; {zeropad}
  292.  
  293. procedure showvers;
  294.   var
  295.     xchar : char;
  296.  
  297.   begin
  298.   xchar:=chr(country[9]);
  299.   if osmajor > 0 then
  300.     begin
  301.     write(osmajor, xchar);
  302.     zeropad(osminor);
  303.     writeln
  304.     end
  305.   else
  306.     writeln('1', xchar, 'x')
  307.   end; {showvers}
  308.  
  309. function cbw(a, b : byte) : word;
  310.   begin
  311.   cbw:=word(b) shl 8 + a
  312.   end; {cbw}
  313.  
  314. function bin16(a : word) : string;
  315.   function bin8(a : byte) : string;
  316.     begin
  317.     bin8:=bin4(a shr 4) + '_' + bin4(a and $0F)
  318.     end; {bin8}
  319.  
  320.   begin {bin16}
  321.   bin16:=bin8(hi(a)) + '_' + bin8(lo(a))
  322.   end; {bin16}
  323.  
  324. procedure drvname(a : byte);
  325.   begin
  326.   write(chr(ord('A') + a), ': ')
  327.   end; {drvname}
  328.  
  329. procedure media(a, b : byte);
  330.   procedure diskette(a, b, c : byte);
  331.     begin
  332.     writeln('floppy ', a, ' side, ', b, ' sctr, ', c, ' trk')
  333.     end; {diskette}
  334.  
  335.   begin {media}
  336.   caption3('Media');
  337.   case a of
  338.     $FF : diskette(2, 8, 40);
  339.     $FE : diskette(1, 8, 40);
  340.     $FD : diskette(2, 9, 40);
  341.     $FC : diskette(1, 9, 40);
  342.     $F9 : if b = 1 then
  343.       diskette(2, 15, 80)
  344.     else
  345.       diskette(2, 9, 80);
  346.     $F8 : writeln('fixed disk');
  347.     $F0 : diskette(2, 18, 80)
  348.     else
  349.       unknown('media', a, 2)
  350.   end
  351.   end; {media}
  352.  
  353. procedure pagenameclr;
  354.   var
  355.     xbyte: byte;
  356.  
  357.   begin
  358.   xbyte:=TextAttr;
  359.   Window(x1, tlength, x2 - 1, tlength);
  360.   TextColor((TextAttr and $70) shr 4);
  361.   ClrScr;
  362.   TextAttr:=xbyte;
  363.   Window(1, 1, twidth, tlength)
  364.   end; {pagenameclr}
  365.  
  366. procedure init;
  367.   var
  368.     xint : integer;
  369.  
  370.   procedure rjustify(a : string);
  371.     begin
  372.     gotoxy(1 + lo(windmax) - length(a), wherey);
  373.     x2:=WhereX;
  374.     write(a)
  375.     end; {rjustify}
  376.  
  377.   procedure border(ch: char);
  378.     var
  379.       i : byte;
  380.  
  381.     begin
  382.     TextColor(LightCyan);
  383.     for i:=1 to twidth do
  384.       write(ch);
  385.     TextColor(LightGray);
  386.     end; {border}
  387.  
  388.   begin {init}
  389.   attrsave:=textattr;
  390.   with regs do
  391.     begin
  392.     AH:=$0F;
  393.     intr($10, regs);
  394.     twidth:=AH;
  395.     vidpg:=BH
  396.     end;
  397.   detectgraph(graphdriver, xint);
  398.   if (graphdriver = EGA) or (graphdriver = MCGA) or (graphdriver = VGA) then
  399.     with regs do
  400.       begin
  401.       AX:=$1130;
  402.       BH:=$00;
  403.       intr($10, regs);
  404.       tlength:=DL + 1;
  405.       CheckSnow:=False;
  406.       end
  407.   else
  408.     tlength:=25;
  409.   with regs do
  410.     begin
  411.     intr($11, regs);
  412.     equip:=AX;
  413.     intr($12, regs);
  414.     DOSmem:=longint(AX) shl 10;
  415.     AH:=$19;
  416.     MSDOS(regs);
  417.     currdrv:=AL;
  418.     AH:=$34;
  419.     MSDOS(regs);
  420.     DOScseg:=ES;
  421.     DOScofs:=BX
  422.     end;
  423.   for i:=$00 to $FF do
  424.     getintvec(i, intvec[i]);
  425.   intvec[$00]:=saveint00;
  426.   intvec[$02]:=saveint02;
  427.   intvec[$1B]:=saveint1B;
  428.   intvec[$23]:=saveint23;
  429.   intvec[$24]:=saveint24;
  430.   intvec[$34]:=saveint34;
  431.   intvec[$35]:=saveint35;
  432.   intvec[$36]:=saveint36;
  433.   intvec[$37]:=saveint37;
  434.   intvec[$38]:=saveint38;
  435.   intvec[$39]:=saveint39;
  436.   intvec[$3A]:=saveint3A;
  437.   intvec[$3B]:=saveint3B;
  438.   intvec[$3C]:=saveint3C;
  439.   intvec[$3D]:=saveint3D;
  440.   intvec[$3E]:=saveint3E;
  441.   intvec[$3F]:=saveint3F;
  442.   intvec[$75]:=saveint75;
  443.   with regs do
  444.     begin
  445.     AX:=$3700;
  446.     MSDOS(regs);
  447.     switchar:=chr(DL)
  448.     end;
  449.   dirsep:=['\'];
  450.   if switchar <> '/' then
  451.     dirsep:=dirsep + ['/'];
  452.   with regs do
  453.     begin
  454.     AH:=$52;
  455.     MSDOS(regs);
  456.     devseg:=ES;
  457.     devofs:=BX
  458.     end;
  459.   lastdrv:=mem[devseg : devofs + $0021];
  460.   window(1, 1, twidth, tlength);
  461.   TextBackground(Blue);
  462.   clrscr;
  463.   textcolor(LightGreen);
  464.   write('INFO+');
  465.   textcolor(lightgray);
  466.   write(' - Information on all computer functions');
  467.   rjustify(qversion);
  468.   writeln;
  469.   border(#223);
  470.   gotoxy(1, tlength - 1);
  471.   border(#220);
  472.   write('Page ');
  473.   x1:=wherex;
  474.   textcolor(Lightgreen);
  475.   rjustify('Enter PgUp PgDn Home End Esc');
  476.   pg:=0;
  477.   endit:=false;
  478.   if osmajor >= 3 then
  479.     with regs do
  480.       begin
  481.       AX:=$3800;
  482.       DS:=seg(country);
  483.       DX:=ofs(country);
  484.       MSDOS(regs);
  485.       ccode:=BX
  486.       end;
  487.   end; {init}
  488.  
  489. procedure CPUID(var a : cpu_info_t);  external;
  490.  
  491. function diskread(drive : byte; starting_sector, number_of_sectors : word
  492.   ; var buffer) : word;  external;
  493.  
  494. {$I PAGE_00.INC}
  495. {$I PAGE_01.INC}
  496. {$I PAGE_02.INC}
  497. {$I PAGE_03.INC}
  498. {$I PAGE_04.INC}
  499. {$I PAGE_05.INC}
  500. {$I PAGE_06.INC}
  501. {$I PAGE_07.INC}
  502. {$I PAGE_08.INC}
  503. {$I PAGE_09.INC}
  504. {$I PAGE_10.INC}
  505. {$I PAGE_11.INC}
  506. {$I PAGE_12.INC}
  507. {$I PAGE_13.INC}
  508. {$I PAGE_14.INC}
  509. {$I PAGE_15.INC}
  510. {$I PAGE_16.INC}
  511. {$I PAGE_17.INC}
  512. (*
  513. **  end subprograms
  514. *)
  515.  
  516. begin
  517.   xword:=dosversion;
  518.   osmajor:=lo(xword);
  519.   osminor:=hi(xword);
  520.   if osmajor >= 3 then
  521.     begin
  522.     init;
  523.     xbool1:=false;
  524.     repeat
  525.       pagenameclr;
  526.       gotoxy(x1, tlength);
  527.       textcolor(lightgray);
  528.       write(pg:2, ' - ');
  529.       case pg of
  530.         0 : Write('Table of Contents');
  531.         1 : Write('Machine & ROM Identification');
  532.         2 : Write('CPU Identification');
  533.         3 : Write('RAM Identification');
  534.         4 : Write('Memory Block Listing');
  535.         5 : Write('Video Identification');
  536.         6 : Write('Video Information');
  537.         7 : Write('Keyboard & Mouse Information');
  538.         8 : Write('Parallel/Serial Port Information');
  539.         9 : Write('DOS Information');
  540.         10: Write('Multiplex Programs');
  541.         11: Write('Environment Variables');
  542.         12: Write('Device Drivers');
  543.         13: Write('DOS Drive Information');
  544.         14: Write('BIOS Drive Information');
  545.         15: Write('Partition Table Listing');
  546.         16: Write('Boot info & DOS drive parameters');
  547.         17: Write('Thanks');
  548.       end;
  549.       window(1, 3, twidth, tlength - 2);
  550.       clrscr;
  551.       case pg of
  552.         0 : page_00;
  553.         1 : page_01;
  554.         2 : page_02;
  555.         3 : page_03;
  556.         4 : page_04;
  557.         5 : page_05;
  558.         6 : page_06;
  559.         7 : page_07;
  560.         8 : page_08;
  561.         9 : page_09;
  562.         10 : page_10;
  563.         11 : page_11;
  564.         12 : page_12;
  565.         13 : page_13;
  566.         14 : page_14;
  567.         15 : page_15;
  568.         16 : page_16;
  569.         17 : page_17
  570.       end;
  571.       window(1, 1, twidth, tlength);
  572.       gotoxy(x2 - 1, tlength);
  573.       xbool2:=false;
  574.       repeat
  575.         if not endit then
  576.           begin
  577.           repeat
  578.           until keypressed;
  579.           xchar1:=readkey;
  580.           if keypressed then
  581.             xchar2:=readkey
  582.           else
  583.             xchar2:=#0;
  584.           end
  585.         else
  586.           begin
  587.           endit:=false;
  588.           xchar1:=c2[1];
  589.           if Length(c2) = 1 then
  590.             xchar2:=#0
  591.           else
  592.             xchar2:=c2[2]
  593.           end;
  594.         if (xchar1 = #27) and (xchar2 = #0) then
  595.           begin
  596.           xbool2:=true;
  597.           xbool1:=true
  598.           end;
  599.         if (xchar1 = #13) and (xchar2 = #0) then
  600.           begin
  601.           pagenameclr;
  602.           GotoXY(x1, tlength);
  603.           TextColor(White);
  604.           Write('Go to page no.=> ');
  605.           i:=getnum;
  606.           if (i >= 0 ) and (i <= pgmax) then
  607.             begin
  608.             pg:=i;
  609.             xbool2:=true
  610.             end;
  611.           pagenameclr
  612.           end;
  613.         if xchar1 = #0 then
  614.           case xchar2 of
  615.             #71: begin
  616.                  xbool2:=true;
  617.                  pg:=0
  618.                  end;
  619.             #73: if pg > 0 then
  620.                    begin
  621.                    xbool2:=true;
  622.                    Dec(pg)
  623.                    end;
  624.             #79: begin
  625.                  xbool2:=true;
  626.                  pg:=pgmax
  627.                  end;
  628.             #81: if pg < pgmax then
  629.                    begin
  630.                    xbool2:=true;
  631.                    Inc(pg)
  632.                    end;
  633.           end;
  634.       if not xbool2 then
  635.         begin
  636.         Sound(220);
  637.         Delay(100);
  638.         NoSound
  639.         end
  640.       until xbool2
  641.     until xbool1;
  642.     textattr:=attrsave;
  643.     clrscr
  644.   end
  645. else
  646.   begin
  647.   writeln;
  648.   country[9]:=Ord('.');
  649.   writeln('INFOPLUS requires DOS version 3.0 or later');
  650.   write('Your DOS version is ');
  651.   showvers
  652.   end
  653. end.
  654.